home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch6 / SetPixs.frm (.txt) < prev    next >
Visual Basic Form  |  1999-04-22  |  7KB  |  238 lines
  1. VERSION 5.00
  2. Begin VB.Form frmSetPixs 
  3.    Caption         =   "SetPixs"
  4.    ClientHeight    =   4350
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   9330
  8.    LinkTopic       =   "Form1"
  9.    Palette         =   "SetPixs.frx":0000
  10.    PaletteMode     =   1  'UseZOrder
  11.    ScaleHeight     =   290
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   622
  14.    StartUpPosition =   3  'Windows Default
  15.    Begin VB.PictureBox picSetBitmapBits 
  16.       AutoRedraw      =   -1  'True
  17.       AutoSize        =   -1  'True
  18.       Height          =   3060
  19.       Left            =   6240
  20.       ScaleHeight     =   200
  21.       ScaleMode       =   3  'Pixel
  22.       ScaleWidth      =   200
  23.       TabIndex        =   7
  24.       Top             =   960
  25.       Width           =   3060
  26.    End
  27.    Begin VB.PictureBox picTriplet 
  28.       AutoRedraw      =   -1  'True
  29.       AutoSize        =   -1  'True
  30.       Height          =   3060
  31.       Left            =   3120
  32.       ScaleHeight     =   200
  33.       ScaleMode       =   3  'Pixel
  34.       ScaleWidth      =   200
  35.       TabIndex        =   2
  36.       Top             =   960
  37.       Width           =   3060
  38.    End
  39.    Begin VB.CommandButton cmdGo 
  40.       Caption         =   "Go"
  41.       Default         =   -1  'True
  42.       Height          =   495
  43.       Left            =   4080
  44.       TabIndex        =   1
  45.       Top             =   120
  46.       Width           =   1095
  47.    End
  48.    Begin VB.PictureBox picPSet 
  49.       AutoRedraw      =   -1  'True
  50.       AutoSize        =   -1  'True
  51.       Height          =   3060
  52.       Left            =   0
  53.       ScaleHeight     =   200
  54.       ScaleMode       =   3  'Pixel
  55.       ScaleWidth      =   200
  56.       TabIndex        =   0
  57.       Top             =   960
  58.       Width           =   3060
  59.    End
  60.    Begin VB.Label Label1 
  61.       Alignment       =   2  'Center
  62.       Caption         =   "Using SetBitmapBits Directly"
  63.       Height          =   255
  64.       Index           =   2
  65.       Left            =   6240
  66.       TabIndex        =   9
  67.       Top             =   720
  68.       Width           =   3060
  69.    End
  70.    Begin VB.Label lblSetbitmapBits 
  71.       Alignment       =   2  'Center
  72.       Height          =   255
  73.       Left            =   6240
  74.       TabIndex        =   8
  75.       Top             =   4080
  76.       Width           =   3060
  77.    End
  78.    Begin VB.Label Label1 
  79.       Alignment       =   2  'Center
  80.       Caption         =   "Using SetPixels"
  81.       Height          =   255
  82.       Index           =   1
  83.       Left            =   3120
  84.       TabIndex        =   6
  85.       Top             =   720
  86.       Width           =   3060
  87.    End
  88.    Begin VB.Label Label1 
  89.       Alignment       =   2  'Center
  90.       Caption         =   "Using PSet"
  91.       Height          =   255
  92.       Index           =   0
  93.       Left            =   0
  94.       TabIndex        =   5
  95.       Top             =   720
  96.       Width           =   3060
  97.    End
  98.    Begin VB.Label lblDDBTime 
  99.       Alignment       =   2  'Center
  100.       Height          =   255
  101.       Left            =   3120
  102.       TabIndex        =   4
  103.       Top             =   4080
  104.       Width           =   3060
  105.    End
  106.    Begin VB.Label lblPSetTime 
  107.       Alignment       =   2  'Center
  108.       Height          =   255
  109.       Left            =   0
  110.       TabIndex        =   3
  111.       Top             =   4080
  112.       Width           =   3060
  113.    End
  114. Attribute VB_Name = "frmSetPixs"
  115. Attribute VB_GlobalNameSpace = False
  116. Attribute VB_Creatable = False
  117. Attribute VB_PredeclaredId = True
  118. Attribute VB_Exposed = False
  119. Option Explicit
  120. ' Set the pixel values in picSetBitmapBits directly.
  121. Private Sub SetPixelsDirectly(ByVal pic As PictureBox)
  122. Dim r(0 To 15) As Byte
  123. Dim g(0 To 15) As Byte
  124. Dim b(0 To 15) As Byte
  125. Dim clr As Long
  126. Dim bits_per_pixel As Integer
  127. Dim hbm As Long
  128. Dim bm As BITMAP
  129. Dim i As Integer
  130. Dim bytes() As Byte
  131. Dim wid As Integer
  132. Dim hgt As Integer
  133. Dim X As Integer
  134. Dim Y As Integer
  135.     ' Initialize the color component lists.
  136.     For i = 0 To 15
  137.         clr = QBColor(i)
  138.         r(i) = clr Mod 256
  139.         g(i) = (clr \ 256) Mod 256
  140.         b(i) = (clr \ 256 \ 256)
  141.     Next i
  142.     ' Get the bitmap information.
  143.     hbm = pic.Image
  144.     GetObject hbm, Len(bm), bm
  145.     bits_per_pixel = bm.bmBitsPixel
  146.     ' Make sure this is a 24-bit image.
  147.     If bits_per_pixel <> 24 Then Exit Sub
  148.     ' Get the bits.
  149.     ReDim bytes(0 To bm.bmWidthBytes - 1, 0 To bm.bmHeight - 1)
  150.     ' Create the pixels array.
  151.     wid = bm.bmWidth
  152.     hgt = bm.bmHeight
  153.     ReDim pixels(0 To wid - 1, 0 To hgt - 1)
  154.     For Y = 0 To hgt - 1
  155.         For X = 0 To wid - 1
  156.             i = ((X \ 10) + (Y \ 10)) Mod 16
  157.             bytes(X * 3, Y) = b(i)
  158.             bytes(X * 3 + 1, Y) = g(i)
  159.             bytes(X * 3 + 2, Y) = r(i)
  160.         Next X
  161.     Next Y
  162.     ' Set the pixel values.
  163.     SetBitmapBits pic.Image, bm.bmWidthBytes * hgt, _
  164.         bytes(0, 0)
  165.     pic.Refresh
  166. End Sub
  167. ' Set each pixel in the pictures.
  168. Private Sub cmdGo_Click()
  169. Dim r(0 To 15) As Byte
  170. Dim g(0 To 15) As Byte
  171. Dim b(0 To 15) As Byte
  172. Dim clr As Long
  173. Dim i As Integer
  174. Dim pixels() As RGBTriplet
  175. Dim bits_per_pixel As Integer
  176. Dim X As Integer
  177. Dim Y As Integer
  178. Dim start_time As Single
  179.     ' Blank previous results.
  180.     cmdGo.Enabled = False
  181.     MousePointer = vbHourglass
  182.     picPSet.Cls
  183.     picTriplet.Cls
  184.     picSetBitmapBits.Cls
  185.     lblPSetTime.Caption = ""
  186.     lblDDBTime.Caption = ""
  187.     lblSetbitmapBits.Caption = ""
  188.     DoEvents
  189.     ' Use Point and PSet.
  190.     start_time = Timer
  191.     For Y = 0 To picPSet.ScaleHeight - 1
  192.         For X = 0 To picPSet.ScaleWidth - 1
  193.             i = ((X \ 10) + (Y \ 10)) Mod 16
  194.             picPSet.PSet (X, Y), QBColor(i)
  195.         Next X
  196.     Next Y
  197.     lblPSetTime.Caption = _
  198.         Format$(Timer - start_time, "0.00") & _
  199.         " seconds"
  200.     DoEvents
  201.     ' Use the RGBTriplet array.
  202.     start_time = Timer
  203.     ' Initialize the color component lists.
  204.     For i = 0 To 15
  205.         clr = QBColor(i)
  206.         r(i) = clr Mod 256
  207.         g(i) = (clr \ 256) Mod 256
  208.         b(i) = (clr \ 256 \ 256)
  209.     Next i
  210.     ' Make room for picTriplet's pixel values.
  211.     ReDim pixels(0 To picTriplet.ScaleWidth - 1, 0 To picTriplet.ScaleHeight - 1)
  212.     ' Set the pixel colors.
  213.     For Y = 0 To picTriplet.ScaleHeight - 1
  214.         For X = 0 To picTriplet.ScaleWidth - 1
  215.             i = ((X \ 10) + (Y \ 10)) Mod 16
  216.             With pixels(X, Y)
  217.                 .rgbRed = r(i)
  218.                 .rgbGreen = g(i)
  219.                 .rgbBlue = b(i)
  220.             End With
  221.         Next X
  222.     Next Y
  223.     ' Set picTriplet's pixels.
  224.     SetBitmapPixels picTriplet, 24, pixels
  225.     lblDDBTime.Caption = _
  226.         Format$(Timer - start_time, "0.00") & _
  227.         " seconds"
  228.     DoEvents
  229.     ' Use SetBitmapBits directly.
  230.     start_time = Timer
  231.     SetPixelsDirectly picSetBitmapBits
  232.     lblSetbitmapBits.Caption = _
  233.         Format$(Timer - start_time, "0.00") & _
  234.         " seconds"
  235.     MousePointer = vbDefault
  236.     cmdGo.Enabled = True
  237. End Sub
  238.